unit uCore;

{$mode objfpc}{$H+}

interface

uses
    Classes, SysUtils, FileUtil, Forms, Buttons, ActnList, ExtCtrls, dynlibs,
    cef3lib, sqldb, sqldblib, uInterfaces, uTypes, uMessages, uMessageTargets,
    uPictureList, uFormLoad, sqlite3conn, contnrs,
    // Embedded modules
    uModuleHistory;


type

    { TISCore }

    TISCore = class(TDataModule, IISCore)
        ApplicationProperties: TApplicationProperties;
        SQLDBLibraryLoader: TSQLDBLibraryLoader;
        procedure ApplicationPropertiesIdle(Sender: TObject; var Done: boolean);
        procedure DataModuleCreate(Sender: TObject);
    private
        // Messages
        // -------------------------------------------------
        FMsgQueue: TISMessageQueue;
        FMsgTargets: TISMessageTargets;
        FPictures16: TPictureList;
        FPictures32: TPictureList;

        // Libraries
        // -------------------------------------------------
        FLibDir: string;

        // Modules
        // -------------------------------------------------
        FModules: TFPHashList;
    protected
        FormLoad: TfrmLoad;

        procedure Init; virtual;
        procedure Done; virtual;

        // -------------------------------------------------
        function CreateConnection(const aConnString: string): TSQLConnection;

        procedure InitPictures;
        procedure PL16Load(const ACount, ADone, APercent: integer; const AFileName, AName: string;
            var ABreak: boolean);
        procedure PL32Load(const ACount, ADone, APercent: integer; const AFileName, AName: string;
            var ABreak: boolean);

        procedure PostMessageInternal(Data: PtrInt);
    public
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;

        // Databases
        // -------------------------------------------------
        function GetDBConnection: TSQLConnection;

        // Spalsh
        // -------------------------------------------------
        procedure SplashShow;
        procedure SplashClose;
        procedure SplashSetState(const aCaption: string);
        procedure SplashUpdateState(const aProgress: Integer);

        // Messaging
        // -------------------------------------------------
        function PostMessage(AMsg: TISMessage): TISMessage;
        procedure RegMessageTarget(AMsgTarget: IISMessageTarget);
        procedure UnregMessageTarget(AMsgTarget: IISMessageTarget);

        // Chromium
        // -------------------------------------------------
        procedure ChromiumSetup;
        procedure ChromiumInit;

        // Open new web page
        procedure NewWebPage(const AURL: string;             // URL address
            const AEngine: TRenderEngine;   // Rendering engine
            const AActivate: boolean);      // Activate page after open

        // Images
        // -------------------------------------------------
        procedure SetBtnGlyph(const aName: string; aBtn: TSpeedButton); overload;
        procedure SetBtnGlyph(const aName: string; aBtn: TBitBtn); overload;
        procedure SetActGlyph(const aName: string; aAct: TAction);
        procedure SetToImage(const aName: string; aImage: TImage);

        property Pic16: TPictureList read FPictures16;
        property Pic32: TPictureList read FPictures32;

        // Modules
        // -------------------------------------------------
        procedure LoadModules;

        procedure RegisterModule(AModule: IISModule);
        function ModuleByCode(const ACode: string): IISModule;

        // Search
        // -------------------------------------------------
        function IsSearchString(const aURL: string): Boolean;

        // Content blocker
        // -------------------------------------------------
        function IsBlocked(const aURL: string; out aTeplate: string): Boolean;
    end;

var
    ISCore: TISCore;

implementation

{$R *.lfm}

{ TISCore }

procedure TISCore.ApplicationPropertiesIdle(Sender: TObject; var Done: boolean);
begin

end;

procedure TISCore.DataModuleCreate(Sender: TObject);
begin
end;

procedure TISCore.Init;
var
    s: string;
begin
    { TODO 1 -oND -cCore : Check for another instance }

    SplashShow;

    // Messaged
    FMsgQueue := TISMessageQueue.Create;
    FMsgTargets := TISMessageTargets.Create;

    // Chromium
    ChromiumSetup;
    ChromiumInit;

    // Pictures
    FPictures16 := TPictureList.Create(Self);
    FPictures16.Width := 16;
    FPictures16.Height := 16;

    FPictures32 := TPictureList.Create(Self);
    FPictures32.Width := 32;
    FPictures32.Height := 32;

    FPictures16.OnLoad := @PL16Load;
    FPictures32.OnLoad := @PL32Load;

    InitPictures;

    // Libraries
    {$ifdef WINDOWS}
    FLibDir := './lib/';
    {$endif}
    {$ifdef LINUX}
    FLibDir := '';
    {$endif}

    SQLDBLibraryLoader.ConnectionType := 'SQLite3';
    SQLDBLibraryLoader.LibraryName := FLibDir + 'sqlite3.' + SharedSuffix;
    SQLDBLibraryLoader.Enabled := True;
    SQLDBLibraryLoader.LoadLibrary;

    // Modules
    // -----------------------------------------------------
    FModules := TFPHashList.Create;
    LoadModules;

end;

procedure TISCore.Done;
begin
    CefShutDown;
    FPictures16.Free;
    FPictures32.Free;
    FMsgQueue.Free;
end;

procedure TISCore.LoadModules;
begin
    // Create embedded modules
    // -----------------------------------------------------

    uModuleHistory.ModuleHistory := uModuleHistory.TModuleHistory.Create;
    RegisterModule(uModuleHistory.ModuleHistory);

    // Load external modules
    // -----------------------------------------------------
end;

procedure TISCore.RegisterModule(AModule: IISModule);
begin
    if FModules.Find(AModule.GetCode) <> nil then
        raise Exception.Create(Format('Core: Module with code %s already registered.', [AModule.GetCode]));
    FModules.Add(AModule.GetCode, AModule);
    AModule.Init(Self);
end;

function TISCore.ModuleByCode(const ACode: string): IISModule;
begin
    Result := IISModule(FModules.Find(ACode));
end;

function TISCore.CreateConnection(const aConnString: string): TSQLConnection;
begin
    Result := TSQLite3Connection.Create(Self);
end;

procedure TISCore.InitPictures;
begin
    // Main
    FormLoad.SetState('Pictures 16:');
    FPictures16.AddPath('res\main\16');
    FormLoad.SetState('Pictures 32:');
    FPictures32.AddPath('res\main\32');
end;

procedure TISCore.PL16Load(const ACount, ADone, APercent: integer; const AFileName, AName: string;
    var ABreak: boolean);
begin
    //Sleep(10);
    FormLoad.UpdateState(APercent);
end;

procedure TISCore.PL32Load(const ACount, ADone, APercent: integer; const AFileName, AName: string;
    var ABreak: boolean);
begin
    //Sleep(10);
    FormLoad.UpdateState(APercent);
end;

procedure TISCore.PostMessageInternal(Data: PtrInt);
var
    msg: IISMessage;
    tg: IISMessageTarget;
    i: Integer;
begin
    msg := TISMessage(Data);
    for i := 0 to FMsgTargets.Count - 1 do
    begin
        tg := FMsgTargets.GetTarget(i);
        if (msg.Target = nil) or (msg.Target = tg) then
        begin
            tg.ProcessMessage(msg as IISMessage);
            if msg.Result = msrDone then
            begin
                FreeAndNil(msg);
                Break;
            end;
        end;
    end;
    if Assigned(msg) then
        msg.Free;
end;

constructor TISCore.Create(AOwner: TComponent);
begin
    inherited Create(AOwner);
    Init;
end;

destructor TISCore.Destroy;
begin
    Done;
    inherited Destroy;
end;

function TISCore.GetDBConnection: TSQLConnection;
begin
    Result := TSQLite3Connection.Create(Application);
end;

procedure TISCore.SplashShow;
begin
    FormLoad := uFormLoad.Show;
end;

procedure TISCore.SplashClose;
begin
    FormLoad.Free;
end;

procedure TISCore.SplashSetState(const aCaption: string);
begin

end;

procedure TISCore.SplashUpdateState(const aProgress: Integer);
begin

end;

function TISCore.PostMessage(AMsg: TISMessage): TISMessage;
begin
    FMsgQueue.PushMsg(AMsg);
    Result := AMsg;
    Application.QueueAsyncCall(@PostMessageInternal, PtrInt(AMsg));
end;

procedure TISCore.RegMessageTarget(AMsgTarget: IISMessageTarget);
begin
    FMsgTargets.AddTarget(AMsgTarget);
end;

procedure TISCore.UnregMessageTarget(AMsgTarget: IISMessageTarget);
begin
end;

procedure TISCore.ChromiumSetup;
const
    subname = 'orcischr'{$IFDEF WINDOWS} + '.exe'{$ENDIF};
begin
    CefSingleProcess := False;
    CefBrowserSubprocessPath := '.' + PathDelim + subname;
    CefCache := '.' + PathDelim + 'cache';
    CefUserAgent := ''; // Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/36.0.1921.0 Safari/537.36
    //CefProductVersion := 'OrcIS 0.0.3';
end;

procedure TISCore.ChromiumInit;
begin
    FormLoad.SetState('CEF3 Init:');
    CefInitDefault;
    FormLoad.UpdateState(100);
end;

procedure TISCore.NewWebPage(const AURL: string; const AEngine: TRenderEngine; const AActivate: boolean);
begin
end;

procedure TISCore.SetBtnGlyph(const aName: string; aBtn: TSpeedButton);
begin
    Pic16.GetBitmapByName(aName, aBtn.Glyph);
end;

procedure TISCore.SetBtnGlyph(const aName: string; aBtn: TBitBtn);
begin
    Pic16.GetBitmapByName(aName, aBtn.Glyph);
end;

procedure TISCore.SetActGlyph(const aName: string; aAct: TAction);
begin
    aAct.ImageIndex := Pic16.IndexByName(aName);
end;

procedure TISCore.SetToImage(const aName: string; aImage: TImage);
begin
    Pic16.GetBitmapByName(aName, aImage.Picture.Bitmap);
end;

function TISCore.IsSearchString(const aURL: string): Boolean;
begin

end;

function TISCore.IsBlocked(const aURL: string; out aTeplate: string): Boolean;
begin

end;

initialization
    //ISCore := TISCore.Create(nil);

end.



